unit uWebserverDM;

interface

uses
  System.SysUtils, System.Classes, IdCustomTCPServer, IdCustomHTTPServer, IdHTTPServer, IdBaseComponent, IdComponent,
  IdServerIOHandler, IdSSL, IdSSLOpenSSL, IdContext, Generics.Collections;

type
  TdmWebserver = class(TDataModule)
    IdHTTPServer1: TIdHTTPServer;
    procedure IdHTTPServer1CommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
    procedure DataModuleCreate(Sender: TObject);
    procedure DataModuleDestroy(Sender: TObject);
  private
    { Private-Deklarationen }
    fContentTypes: TDictionary<string, string>;

    function isAPIRequest(const aDocument: string): boolean;

    function DocumentToPath(const aDocument: string): string;

    procedure HandleAPIRequest(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
    procedure HandleFileRequest(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);

    procedure InitContentTypes;
  public
    { Public-Deklarationen }
  end;

var
  dmWebserver: TdmWebserver;

implementation

uses
  IOUtils, IdSocketHandle, uSettings, WebAPI.Factory, WebAPI.Intf, WebAPI.Invoker;

{ %CLASSGROUP 'Vcl.Controls.TControl' }

{$R *.dfm}

procedure TdmWebserver.DataModuleCreate(Sender: TObject);
var
  socket: TIdSocketHandle;
begin
  socket := IdHTTPServer1.Bindings.Add;
  socket.IP := '0.0.0.0';
  socket.Port := TSettings.Instance.HTTPPort;
  IdHTTPServer1.Active := true;

  InitContentTypes;
end;

procedure TdmWebserver.DataModuleDestroy(Sender: TObject);
begin
  fContentTypes.Free;
  try
    // IdHTTPServer1.Active := false;
  except

  end;
end;

function TdmWebserver.DocumentToPath(const aDocument: string): string;
begin
  result := aDocument.Replace('/', '\', [rfReplaceAll])
end;

procedure TdmWebserver.HandleAPIRequest(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo;
  AResponseInfo: TIdHTTPResponseInfo);
var
  documentParts: TArray<string>;
  version, command: string;
  api: IWebAPI;
  i: integer;
begin
  documentParts := ARequestInfo.Document.Split(['/'], TStringSplitOptions.ExcludeEmpty);
  version := documentParts[1];

  command := '';
  for i := 2 to high(documentParts) do
  begin
    command := command + documentParts[i];
  end;

  api := TWebAPIFactory.newAPI(version);
  AResponseInfo.ContentText := TWebAPIInvoker.Invoke(api, command, nil)
end;

procedure TdmWebserver.HandleFileRequest(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo;
  AResponseInfo: TIdHTTPResponseInfo);
var
  fn: string;
  ext: string;
begin
  fn := TSettings.Instance.WWWPath + DocumentToPath(ARequestInfo.Document);
  if TFile.Exists(fn) then
  begin
    ext := ExtractFileExt(fn);
    delete(ext, 1, 1); // Remove "."
    AResponseInfo.ContentType := fContentTypes[ext];
    AResponseInfo.ContentStream := TFile.OpenRead(fn);
    AResponseInfo.FreeContentStream := true;
  end
  else
    AResponseInfo.ResponseNo := 404;
end;

procedure TdmWebserver.IdHTTPServer1CommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo;
  AResponseInfo: TIdHTTPResponseInfo);
begin
  if isAPIRequest(ARequestInfo.Document) then
    HandleAPIRequest(AContext, ARequestInfo, AResponseInfo)
  else // Is File Request
    HandleFileRequest(AContext, ARequestInfo, AResponseInfo);
end;

procedure TdmWebserver.InitContentTypes;
begin
  fContentTypes := TDictionary<string, string>.Create;
  fContentTypes.Add('htm', 'text/html');
  fContentTypes.Add('html', 'text/html');
  fContentTypes.Add('js', 'text/javascript');
  fContentTypes.Add('css', 'text/css');
  fContentTypes.Add('appcache', 'text/cache-manifest');
  fContentTypes.Add('gif', 'image/gif');
  fContentTypes.Add('png', 'image/png');
  fContentTypes.Add('json', 'application/json');
  fContentTypes.Add('jpg', 'image/jpg');
  fContentTypes.Add('jpeg', 'image/jpeg');
  fContentTypes.Add('ico', 'image/ico');
end;

function TdmWebserver.isAPIRequest(const aDocument: string): boolean;
begin
  result := aDocument.StartsWith('/api/');
end;

end.
